;;;Copy most entities from Blocks or XREFs.
;;;
;;;	Author:
;;;		Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;
;;;	http://www.paracadd.com
;;;	All rights reserved.
;;;
;;;	Copyright: 1996-2011
;;;	Edited:	   7-25-2003
;;;
;;;	Requirements: ukword.lsp, transpt.lsp
;;;
;;;****************************************************************************
(defun c:cpl (/ exornew plii new_bname nextent assoc_8_lst)
                                        ;       (/ plstrt plnxt xplent selent plv lnndx cur_la nplhe plent)
  (setq blk_lst nil)
  (if ukword
    nil
    (load "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (if ustr
    nil
    (load "ustr" "\nFile USTR.LSP not loaded! ")
  ) ;_ end of if
  (setq ctokwd (ukword 1
                       "Current Entity Road-name"
                       "Copy to [Current/Entity/Road-name] layer? "
                       (if ctokwd
                         ctokwd
                         "Current"
                       ) ;_ end of if
               ) ;_ end of ukword
  ) ;_ end of setq
  (if dimscl
    nil
    (load "DIMSCL" "\nFile DIMSCL.LSP not loaded! ")
  ) ;_ end of if
  (dimscl)
;;;  (SETQ markcpl (ukword 1 "Yes No" "temporarily mark copied entites? [Yes/No]" markcpl))
  (while
    (setq plii (nentsel))
    (setq plii_50 (assoc 50 (entget(car plii))))
     (setq pliii  plii
           plstrt (entnext (nth 0 plii))
           xplent (cdr (entget (nth 0 plii)))
           selent (cdr (assoc 0 xplent))
     ) ;_ end of setq
     (COND ((AND (EQ (TYPE (LAST pliii)) 'LIST)
                 (EQ (TYPE (CAR (LAST pliii))) 'ENAME)
            ) ;_ end of AND
            (SETQ insparent (entget (car (last pliii))))
           )
           ((EQ (TYPE (LAST pliii)) 'ENAME)
            (SETQ insparent (entget (last pliii)))
           )
           (T (SETQ insparent NIL))
     ) ;_ end of COND
     (princ "\n")
     (princ selent)
     (IF (EQ selent "MLINE")
       (PROGN
         (princ
           "\n\t\tMLINEs CANNOT be copied! (AutoCAD will allow it but it corrupts the drawing beyond repair."
         ) ;_ end of princ
         (princ)
       ) ;_ end of PROGN
       (if (> (length plii) 2)
         (progn
           (setq insent (entget (caar (reverse plii)))
                 insang (cdr (assoc 50 insent))
           ) ;_ end of setq
           (if (eq selent "VERTEX")
             (setq plv   (entget (entnext plstrt))
                   plnxt (cdr (assoc -1 plv))
             ) ;_ end of setq
             (COND
               ((EQ (CDR (ASSOC 0 (ENTGET (CAR (LAST plii))))) "DIMENSION")
                 (PROGN
                   (setq diment (ENTGET (CAR (LAST plii))))
                   (setq diment (APPEND (REVERSE (CDR (MEMBER (ASSOC 2 diment) (REVERSE diment))))(CDR (MEMBER (ASSOC 2 diment) diment))))
                   (setq diment (APPEND (REVERSE (CDR (MEMBER (ASSOC 8 diment) (REVERSE diment))))(CDR (MEMBER (ASSOC 8 diment) diment))))
                   (setq diment (APPEND (REVERSE (CDR (MEMBER (ASSOC 3 diment) (REVERSE diment))))(CDR (MEMBER (ASSOC 3 diment) diment))))
                   (entmake diment)
                 ))
               ((EQ (CDR (ASSOC 0 (ENTGET (CAR plii)))) "MULTILEADER")
                 (PROGN
                   (setq diment (ENTGET (CAR plii)))
                   (setq diment (APPEND (REVERSE (CDR (MEMBER (ASSOC 8 diment) (REVERSE diment))))(CDR (MEMBER (ASSOC 8 diment) diment))))
                   (entmake diment)
                 ))
             )
           ) ;_ end of if
           (if transpt
             nil
             (load "transpt" "\nFile TRANSPT.LSP not loaded! ")
           ) ;_ end of if
           (if (eq selent "VERTEX")
             (progn
               (while
                 (/= (cdr (assoc 0 (entget plnxt))) "SEQEND")
                  (setq plv   (entget (entnext plnxt))
                        plnxt (cdr (assoc -1 plv))
                  ) ;_ end of setq
               ) ;_ end of while
               (setq nplhe (entget (cdr (assoc -2 (entget plnxt))))
                     plnxt (entnext (cdr (assoc -1 nplhe)))
               ) ;_ end of setq
               (if (assoc 6 nplhe)
                 (if (wcmatch (cdr (assoc 6 nplhe)) "*|*")
                   (progn
                     (setq lnndx 1)
                     (while
                       (/= (substr (cdr (assoc 6 nplhe)) lnndx 1) "|")
                        (setq lnndx (1+ lnndx))
                     ) ;_ end of while
                     (setq
                       cur_lt (substr (cdr (assoc 6 nplhe)) (1+ lnndx))
                     ) ;_ end of setq
                   ) ;_ end of progn
                   (setq cur_lt (cdr (assoc 6 nplhe)))
                 ) ;_ end of if
                 (progn
                   (setq cur_lt
                          (cdr (assoc
                                 6
                                 (tblsearch "LAYER" (cdr (assoc 8 nplhe)))
                               ) ;_ end of assoc
                          ) ;_ end of cdr
                   ) ;_ end of setq
                   (if (wcmatch cur_lt "*|*")
                     (progn
                       (setq lnndx 1)
                       (while (/= (substr cur_lt lnndx 1) "|")
                         (setq lnndx (1+ lnndx))
                       ) ;_ end of while
                       (setq cur_lt (substr cur_lt (1+ lnndx)))
                     ) ;_ end of progn
                   ) ;_ end of if
                 ) ;_ end of progn
               ) ;_ end of if
               (cond
                 ((eq ctokwd "Entity")
                  (if (wcmatch (cdr (assoc 8 nplhe)) "*|*")
                    (progn
                      (setq xplayr (cdr (assoc 8 nplhe))
                            cur_la xplayr
                      ) ;_ end of setq
                      (while
                        (wcmatch cur_la "*|*")
                         (setq cur_la (substr cur_la 2))
                      ) ;_ end of while
                      (IF (WCMATCH (STRCASE cur_la) "*-NPLT")
                        (SETQ cur_la (SUBSTR curla 1 (-(STRLEN cur_la) 5)))
                      )
                    ) ;_ end of progn
                    (PROGN
                      (setq cur_la (cdr (assoc 8 nplhe))
                            xplayr NIL
                      ) ;_ end of setq
                      (IF (WCMATCH (STRCASE cur_la) "*-NPLT")
                        (SETQ cur_la (SUBSTR curla 1 (-(STRLEN cur_la) 5)))
                      )
                    ) ;_ end of PROGN
                  ) ;_ end of if
                 )
                 ((eq ctokwd "Current")
                  (setq cur_la (getvar "clayer")
                        xplayr NIL
                  ) ;_ end of setq
                 )
                 ((eq ctokwd "Road-name")
                  (if gvpno nil (load "gvpno" "\nFile GVPNO.LSP not loaded! "))
                  (gvpno)
                  (IF viewno
                    (PROGN
                      (SETQ cur_la (STRCAT "C-VI" (IF (< viewno 10) "0" "")(ITOA viewno)"4NOTE")
                            xplayr NIL
                      )
                    )
                    (setq cur_la (getvar "clayer")
                          xplayr NIL
                    ) ;_ end of setq
                  )
                 )
               ) ;_ end of cond
               (setq nplhe
                      (subst
                        (cons 8 cur_la)
                        (assoc 8 nplhe)
                        nplhe
                      ) ;_ end of subst
               ) ;_ end of setq
               (if (assoc 6 nplhe)
                 (setq nplhe
                        (subst
                          (cons 6 cur_lt)
                          (assoc 6 nplhe)
                          nplhe
                        ) ;_ end of subst
                 ) ;_ end of setq
               ) ;_ end of if
               (SETQ NPLHEMOD
                      (append
                        (list (assoc 0 nplhe))
                        (member (assoc 100 nplhe) nplhe)
                      ) ;_ end of append
               ) ;_ end of SETQ
                                        ;	 (PRINC nplhe)
                                        ;	 (PRINC
;;;	     (entmake (cdr nplhe))
;;;	     (entmake
;;;	       (list
;;;		 (assoc 0 nplhe)
;;;		 (assoc 6 nplhe)
;;;		 (assoc 8 nplhe)
;;;		 (assoc 10 nplhe)
;;;		 (assoc 40 nplhe)
;;;		 (assoc 41 nplhe)
;;;		 (assoc 62 nplhe)
;;;		 (assoc 66 nplhe)
;;;		 (assoc 67 nplhe)
;;;		 (assoc 70 nplhe)
;;;		 (assoc 71 nplhe)
;;;		 (assoc 72 nplhe)
;;;		 (assoc 73 nplhe)
;;;		 (assoc 74 nplhe)
;;;		 (assoc 75 nplhe)
;;;		 (assoc 100 nplhe)
;;;		 (assoc 210 nplhe)
;;;		))
               (IF
                 (entmake nplhemod)
                  (PRINC "\n  Made Replicate Polyline header! ")
                  (PROGN
                    (IF
                      (entmake '((0 . "POLYLINE")))
                       (PRINC "\n  Made Basic Polyline header! ")
                       (PRINC "\n  Did NOT Make Basic Polyline header! ")
                    ) ;_ end of IF
                  ) ;_ end of PROGN
               ) ;_ end of IF
;;;	     (princ "\n  NPLHEMOD ENTITY DATA:\n")
;;;	     (princ nplhemod)
;;;	     (princ)
                                        ;	 )
               (while
                 (/= (cdr (assoc 0 (entget plnxt))) "SEQEND")
                  (IF (EQ (TYPE (car (last plii))) 'ENAME)
                    (PROGN
                      (setq ite (entget (car (last plii)))); vertex entdef
                      (SETQ itep (cdr (assoc 10 ite))); vertex point
                      (setq
                        newplpt (polar
                                  (polar (cdr (assoc 10 (entget plnxt)))
                                         0
                                         (car itep); X offset
                                  ) ;_ end of polar
                                  (/ pi 2.0)
                                  (cadr itep); Y offset
                                ) ;_ end of polar
                      ) ;_ end of setq
                      (SETQ newplpt
                             (LIST
                               (CAR newplpt)
                               (CADR newplpt)
                               (ATOF
                                 (RTOS (+ (CADDR newplpt) (CADDR itep))
                                       2
                                       4
                                 ) ;_ end of RTOS
                               ) ;_ end of ATOF
                             ) ;_ end of LIST
                      ) ;_ end of SETQ
                    ) ;_ end of PROGN
                    (SETQ newplpt NIL)
                  ) ;_ end of IF
                  (setq
                    newdpt
;;;		     (transpt plii (cdr (assoc 10 (entget plnxt))))
                     (IF newplpt
                       newplpt
                       (cdr (assoc 10 (entget plnxt)))
                     ) ;_ end of IF
                  ) ;_ end of setq
                  (setq plent (entget plnxt))
                  (if (assoc 6 plent)
                    (setq plent
                           (subst
                             (cons 6 cur_lt)
                             (assoc 6 plent)
                             plent
                           ) ;_ end of subst
                    ) ;_ end of setq
                  ) ;_ end of if
                  (setq plent
                         (subst
                           (cons 8 cur_la)
                           (assoc 8 plent)
                           plent
                         ) ;_ end of subst
                  ) ;_ end of setq
                  (setq plent
                         (subst
                           (cons 10 newdpt)
                           (assoc 10 plent)
                           plent
                         ) ;_ end of subst
                  ) ;_ end of setq
                                        ;	   (PRINC plent)
                                        ;	    (PRINC
                  (entmake plent)
;;;	     (princ "\n  PLENT ENTITY DATA:\n")
;;;	     (princ plent)
;;;	     (princ)
;;;	       (SETQ PLENTMOD 
;;;	       (append
;;;		 (list(assoc 0 plent))
;;;		 (member(assoc 100 plent)plent)
;;;	       ))
;;; ;;;		 (assoc 100 plent)
;;; ;;;		 (assoc 67 plent)
;;; ;;;		 (assoc 410 plent)
;;; ;;;		 (assoc 8 plent)
;;; ;;;		 (assoc 62 plent)
;;; ;;;		 (assoc 6 plent)
;;; ;;;		 (assoc 100 (cdr(member(assoc 100 plent)plent)))
;;; ;;;		 (assoc 100 (cdr(member(assoc 100 (cdr(member(assoc 100 plent)plent)))plent)))
;;; ;;;		 (assoc 10 plent)
;;; ;;;		 (assoc 40 plent)
;;; ;;;		 (assoc 41 plent)
;;; ;;;		 (assoc 42 plent)
;;; ;;;		 (assoc 70 plent)
;;; ;;;		 (assoc 50 plent)
;;; ;;;		))
;;; ;;;	     (IF
;;; ;;;               (entmake PLENTMOD)
;;; ;;;	       (PRINC "\n  Made Polyline vertex! ")
;;; ;;;	       (PROGN
;;; ;;;		 (IF
;;;;;;                   (entmake (LIST(CONS 0 "VERTEX")(assoc 8 plent)(ASSOC 10 plent)(CONS 70 0)))
;;; ;;;                   (PRINC "\n  Made Polyline vertex! ")
;;; ;;;                   (PRINC "\n  Did NOT Make Polyline vertex! ")
;;; ;;;		 )
;;; ;;;	       )
;;; ;;;	     )
                                        ;	    )
                  (setq plnxt (entnext (cdr (assoc -1 (entget plnxt)))))
               ) ;_ end of while
                                        ;	 (PRINC (list (cons 0 "SEQEND")))
                                        ;	 (PRINC
               (entmake (list (cons 0 "SEQEND")))
                                        ;	 )
             ) ;_ end of progn
             (progn
               (if (AND plii (eq (LENGTH (nth 0 (reverse plii))) 2))
                 (IF
                   (and
                     (eq (cdr
                           (assoc 0 (entget (car (nth 0 (reverse plii)))))
                         ) ;_ end of cdr
                         "INSERT"
                     ) ;_ end of eq
                     (NOT
                       (WCMATCH
                         (cdr (assoc 2
                                     (entget (car (nth 0 (reverse plii))))
                              ) ;_ end of assoc
                         ) ;_ end of cdr
                         "*|*"
                       ) ;_ end of WCMATCH
                     ) ;_ end of NOT
                   ) ;_ end of and
                    NIL
                    (IF
                      (and
                        (eq (cdr
                              (assoc 0
                                     (entget (cadr (nth 0 (reverse plii))))
                              ) ;_ end of assoc
                            ) ;_ end of cdr
                            "INSERT"
                        ) ;_ end of eq
                        (NOT
                          (WCMATCH
                            (cdr
                              (assoc 2
                                     (entget (cadr (nth 0 (reverse plii))))
                              ) ;_ end of assoc
                            ) ;_ end of cdr
                            "*|*"
                          ) ;_ end of WCMATCH
                        ) ;_ end of NOT
                      ) ;_ end of and
                       (SETQ
                         plii (SUBST (LIST (cadr (nth 0 (reverse plii))))
                                     (LAST plii)
                                     plii
                              ) ;_ end of SUBST
                       ) ;_ end of SETQ
                    ) ;_ end of IF
                 ) ;_ end of IF
               ) ;_ end of if
               (if
                 (and
                   (eq
                     (cdr (assoc 0 (entget (car (nth 0 (reverse plii)))))
                     ) ;_ end of cdr
                     "INSERT"
                   ) ;_ end of eq
                   (> (length (nth 0 (reverse plii))) 1)
                 ) ;_ end of and
                  (progn
                    (setq ins_def
                           (IF
                             (EQ (TYPE (CAR (REVERSE (nth 0 (reverse plii)))))
                                 'ENAME
                             ) ;_ end of EQ
                              (ENTGET (CAR (nth 0 (reverse plii))))
                              (entget (car (car (nth 0 (reverse plii)))))
                           ) ;_ end of IF
                    ) ;_ end of setq
                    (setq
                      blk_def
                       (tblsearch "block" (cdr (assoc 2 ins_def)))
                    ) ;_ end of setq
                    (setq
                      blk_def
                       (subst (cons 70 0) (assoc 70 blk_def) blk_def)
                    ) ;_ end of setq
                    (setq old_bname (cdr (assoc 2 blk_def)))
                    (if (wcmatch old_bname "*|*")
                      (progn
                        (setq new_bname (substr old_bname 2))
                        (while (wcmatch new_bname "*|*")
                          (setq new_bname (substr new_bname 2))
                        ) ;_ end of while
                        (if (tblsearch "block" new_bname)
                          (progn
                            (setq redef_blk
                                   (ukword
                                     1
                                     "Yes No"
                                     (strcat
                                       "*** WARNING *** Block "
                                       new_bname
                                       " exists. Do you want to redefine it?"
                                     ) ;_ end of strcat
                                     "No"
                                   ) ;_ end of ukword
                            ) ;_ end of setq
                            (if (eq redef_blk "No")
                              (progn
                                (setq exornew
                                       (ukword
                                         1
                                         "Existing New"
                                         "Make New block definition or use Existing?"
                                         "Existing"
                                       ) ;_ end of ukword
                                ) ;_ end of setq
                                (if (eq exornew "New")
                                  (progn
                                    (while
                                      (tblsearch "block"
                                                 (setq new_bname
                                                        (ustr
                                                          1
                                                          (strcat
                                                            "*** WARNING *** Block "
                                                            new_bname
                                                            " exists. Enter a new name."
                                                          ) ;_ end of strcat
                                                          new_bname
                                                          nil
                                                        ) ;_ end of ustr
                                                 ) ;_ end of setq
                                      ) ;_ end of tblsearch
                                    ) ;_ end of while
                                    (setq
                                      blk_def (subst (cons 2 new_bname)
                                                     (assoc 2 blk_def)
                                                     blk_def
                                              ) ;_ end of subst
                                    ) ;_ end of setq
                                    (setq new_def
                                           (reverse (cdr (reverse blk_def)))
                                    ) ;_ end of setq
                                    (setq blk_lst (list new_def))
                                  ) ;_ end of progn
                                  (PROGN
                                    (SETQ
                                      blk_def
                                       (tblsearch "block" new_bname)
                                    ) ;_ end of SETQ
                                    (fixblktxt new_bname)
                                  ) ;_ end of progn
                                ) ;_ end of if
                              ) ;_ end of progn
                            ) ;_ end of if
                          ) ;_ end of progn
                          (progn
                            (setq blk_def (subst (cons 2 new_bname)
                                                 (assoc 2 blk_def)
                                                 blk_def
                                          ) ;_ end of subst
                            ) ;_ end of setq
                            (setq
                              new_def (reverse (cdr (reverse blk_def)))
                            ) ;_ end of setq
                            (setq blk_lst (list new_def))
                          ) ;_ end of progn
                        ) ;_ end of if
                      ) ;_ end of progn
                    ) ;_ end of if
                    (setq nextent (entget (cdr (assoc -2 blk_def))))
                    (while
                      (and nextent (/= (cdr (assoc 0 nextent)) "INSERT"))
                       (if (assoc 6 nextent)
                         (progn
                           (setq old_eltyp (cdr (assoc 6 nextent)))
                           (if (wcmatch old_eltyp "*|*")
                             (progn
                               (setq new_eltyp (substr old_eltyp 2))
                               (while (wcmatch new_eltyp "*|*")
                                 (setq new_eltyp (substr new_eltyp 2))
                               ) ;_ end of while
                               (setq nextent (subst (cons 6 new_eltyp)
                                                    (assoc 6 nextent)
                                                    nextent
                                             ) ;_ end of subst
                               ) ;_ end of setq
                             ) ;_ end of progn
                           ) ;_ end of if
                         ) ;_ end of progn
                       ) ;_ end of if
                       (setq old_elayr (cdr (assoc 8 insent)))
                       (if
                         (and (wcmatch old_elayr "*|*") (eq useoldlay T))
                          (progn
                            (setq new_elayr (substr old_elayr 2))
                            (while (wcmatch new_elayr "*|*")
                              (setq new_elayr (substr new_elayr 2))
                            ) ;_ end of while
                            (setq nextent (subst (cons 8 new_elayr)
                                                 (assoc 8 nextent)
                                                 nextent
                                          ) ;_ end of subst
                            ) ;_ end of setq
                          ) ;_ end of progn
                          (setq nextent (subst (cons 8 "0")
                                               (assoc 8 nextent)
                                               nextent
                                        ) ;_ end of subst
                          ) ;_ end of setq
                       ) ;_ end of if
                       (setq blk_lst (append blk_lst (list nextent)))
                       (if (entnext (cdr (assoc -1 nextent)))
                         (setq nextent
                                (entget (entnext (cdr (assoc -1 nextent))))
                         ) ;_ end of setq
                         (setq nextent nil)
                       ) ;_ end of if
                    ) ;_ end of while
                    (if
                      (AND
                        nextent
                        (NOT (EQ (CDR (ASSOC 2 nextent)) "DWG-EDIT-LOG"))
                      ) ;_ end of AND
                       (progn
                         (PRINC "\nnextent=")
                         (PRINC nextent)
                         (PRINC)
                         (princ "\nCannot process nested blocks! ")
                                        ;Let's try to insert the block name we found. ")
                         (SETQ nextent_osmode (GETVAR "OSMODE"))
                                        ; THIS WORKS FOR A BLOCK BUT MAKES LINES FAIL - NEEDS WORK
                         (SETVAR "OSMODE" 0)
                         (IF (EQ new_bname "ARV")
                           (COMMAND
                             ".-INSERT"
                             new_bname
                             (SETQ ITPT
                                    (CDR
                                      (ASSOC 10
                                             (ENTGET (car (nth 0 (reverse plii))))
                                      ) ;_ end of ASSOC
                                    ) ;_ end of CDR
                             ) ;_ end of SETQ
                             DIMSC
                             DIMSC
                             (- 0 (* 180 (/ (GETVAR "VIEWTWIST") PI)))
                           ) ;_ end of COMMAND
                         ) ;_ end of IF
                         (SETVAR "OSMODE" nextent_osmode)
                       ) ;_ end of progn
                       (progn
                         (setq blk_lst
                                (append blk_lst (list (list (cons 0 "ENDBLK"))))
                         ) ;_ end of setq
                         (setq old_ilayr (cdr (assoc 8 ins_def)))
                         (if (wcmatch old_ilayr "*|*")
                           (progn
                             (setq new_ilayr (substr old_ilayr 2))
                             (while (wcmatch new_ilayr "*|*")
                               (setq new_ilayr (substr new_ilayr 2))
                             ) ;_ end of while
                             (if (eq ctokwd "Entity")
                               (setq ins_def (subst (cons 8 new_ilayr)
                                                    (assoc 8 ins_def)
                                                    ins_def
                                             ) ;_ end of subst
                               ) ;_ end of setq
                               (setq
                                 ins_def
                                  (subst (cons 8 (getvar "clayer"))
                                         (assoc 8 ins_def)
                                         ins_def
                                  ) ;_ end of subst
                               ) ;_ end of setq
                             ) ;_ end of if
                           ) ;_ end of progn
                         ) ;_ end of if
                         (setq ins_def (subst (cons 2 new_bname)
                                              (assoc 2 ins_def)
                                              ins_def
                                       ) ;_ end of subst
                         ) ;_ end of setq
                         (if (or (eq exornew "New")
                                 (and
                                   new_bname
                                   (not (tblsearch "block" new_bname))
                                 ) ;_ end of and
                             ) ;_ end of or
                           (foreach n blk_lst (entmake n))
                           (fixblktxt new_bname)
                         ) ;_ end of if
                         (if (eq (car (nth 0 ins_def)) -1)
                           (setq ins_def (cdr ins_def))
                         ) ;_ end of if
                         (if (assoc 66 ins_def)
                           (setq ins_def
                                  (append
                                    (reverse (cdr (member (assoc 66 ins_def)
                                                          (reverse ins_def)
                                                  ) ;_ end of member
                                             ) ;_ end of cdr
                                    ) ;_ end of reverse
                                    (cdr (member (assoc 66 ins_def) ins_def)
                                    ) ;_ end of cdr
                                  ) ;_ end of append
                           ) ;_ end of setq
                         ) ;_ end of if
                         (entmake)
                         (if (and
                               (> (LENGTH (ASSOC 2 ins_def)) 1)
                               (entmake ins_def)
                             ) ;_ end of and
                           (progn
                             (princ
                               (strcat "\nInsert of "
                                       new_bname
                                       " created "
                               ) ;_ end of strcat
                             ) ;_ end of princ
                             (entmake)
                           ) ;_ end of progn
                           (progn
                             (princ "\nInsert NOT created ")
                             (entmake)
                           ) ;_ end of progn
                         ) ;_ end of if
;;;		(setq pline_cnt 1			;This section makes plines of Aerial "Water" blocks.
;;;		      stopents nil)
;;;		(entmake)
;;;		(foreach n blk_lst
;;;		  (if stopents nil
;;;		  (if (eq pline_cnt 1)
;;;		    (progn
;;;		      (entmake n)
;;;		      (entmake (list
;;;			       (cons 0 "polyline")
;;;			       (cons 8 "water")
;;;			       (cons 66 1)
;;;			       (cons 10 (cdr (assoc 10 n)))
;;;			     )
;;;		      )
;;;		    )
;;;		    (if (equal(car n)(cons 0 "ENDBLK"))
;;;		      (progn
;;;			(if
;;;		          (entmake (list(cons 0 "SEQEND")))
;;;			  (princ "\nPolyline created! ")
;;;			)
;;;			(entmake (list(cons 0 "ENDBLK")))
;;;			(if (entmake ins_def)
;;;			  (princ (strcat "\nInsert of " new_bname " created "))
;;;			  (princ "\nInsert NOT created ")
;;;			) ;_ end of if
;;;			(setq stopents T)
;;;		      )
;;;		      (progn
;;;			(princ "\n")
;;;			(princ n)
;;;		        (entmake (list
;;;			           (cons 0 "vertex")
;;;			           (cons 8 "water")
;;;			           (cons 10 (cdr(assoc 10 n)))
;;;			         )
;;;		        )
;;;		        (entmake (list
;;;			           (cons 0 "vertex")
;;;			           (cons 8 "water")
;;;			           (cons 10 (cdr(assoc 11 n)))
;;;			         )
;;;		        )
;;;		      )
;;;		    )
;;;		  )
;;;		  )
;;;		  (setq pline_cnt (1+ pline_cnt))
;;;		)
                         (princ
                           "\nRemember, Aerial Survey \"water\" blocks can be made into plines. "
                         ) ;_ end of princ
                         (entmake)
                       ) ;_ end of progn
                    ) ;_ end of if
                  ) ;_ end of progn
                  (progn
                    (cond
                      ((eq ctokwd "Entity")
                       (if
                         (wcmatch (setq xplayr (cdr (assoc 8 xplent)))
                                  "*|*"
                         ) ;_ end of wcmatch
                          (progn
                            (setq cur_la xplayr)
                            (while
                              (wcmatch cur_la "*|*")
                               (setq cur_la (substr cur_la 2))
                            ) ;_ end of while
                            (IF (WCMATCH (STRCASE cur_la) "*-NPLT")
                              (SETQ cur_la (SUBSTR cur_la 1 (-(STRLEN cur_la) 5)))
                            )
                          ) ;_ end of progn
                          (PROGN
                            (setq cur_la xplayr
                                  xplayr NIL
                            ) ;_ end of setq
                            (IF (WCMATCH (STRCASE cur_la) "*-NPLT")
                              (SETQ cur_la (SUBSTR cur_la 1 (-(STRLEN cur_la) 5)))
                            )
                          )
                       ) ;_ end of if
                      )
                      ((eq ctokwd "Current")
                       (setq cur_la (getvar "clayer"))
                      )
                      ((eq ctokwd "Road-name")
                       (if gvpno nil (load "gvpno" "\nFile GVPNO.LSP not loaded! "))
                       (gvpno)
                       (IF viewno
                         (PROGN
                           (SETQ cur_la (STRCAT "C-VI" (IF (< viewno 10) "0" "")(ITOA viewno)"4NOTE")
                                 xplayr NIL
                           )
                         )
                         (setq cur_la (getvar "clayer")
                               xplayr NIL
                         ) ;_ end of setq
                       )
                      )
                    ) ;_ end of cond
                    (IF (EQ selent "LWPOLYLINE")
                      (PROGN
                        (REPEAT 6 (SETQ xplent (CDR xplent)))
                        (IF (ASSOC 410 xplent)
                          NIL
                          (SETQ xplent (CONS (CONS 410 "Model") xplent))
                        )
                        (IF (ASSOC 67 xplent)
                          NIL
                          (SETQ xplent (CONS (CONS 67 0) xplent))
                        )
                        (IF (MEMBER (CONS 100  "AcDbEntity") xplent)
                          NIL
                          (SETQ xplent (CONS (CONS 100 "AcDbEntity") 